Pensieve Header: Wheeled Semi-Symmetrized calculus in the 2D quotient: Solving for the “conj” coefficients, II.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\w-Computations"]

ar[i_,j_] := t[i]h[j]

μCollect[μ_] := Collect[μ, _h, Collect[#, _t, FullSimplify]&];
SetAttributes[μForm, Listable];
μForm[μ_] := Module[
{tails, heads, mat},
tails = Union[Cases[μ, t[s_] :> s, Infinity]];
heads = Union[Cases[μ, h[s_] :> s, Infinity]];
mat = Outer[Coefficient[μ, h[#1] t[#2]]&, heads, tails];
PrependTo[mat, t /@ tails];
mat = Prepend[Transpose[mat],
Prepend[h /@ heads, μ /. (h[_]|t[_]) -> 0]
];
MatrixForm[mat]
]

hm[x_,y_,z_][μ_] := Module[
{ξ, η},
ξ = D[μ, h[x]];
η = D[μ, h[y]];
μCollect[(μ /. h[x|y]->0) + ξ h[z] + (1+ξ /. t[i_]:>c[i])η h[z]]
]

hm[3,4,5][ar[1,3]+ar[2,4]]

hm[3,4,5][ar[1,3]+ar[2,4]] // μForm

μ1=ar[1,4]+ar[2,5]+ar[3,6]

μ1 // μForm

hm[4,5,7][μ1]

hm[7,6,8][hm[4,5,7][μ1]]

hm[4,7,8][hm[5,6,7][μ1]] // μForm

hm[7,6,8][hm[4,5,7][μ1]] - hm[4,7,8][hm[5,6,7][μ1]]

hfac[z_, xtails_List -> x_, y_][μ_] := Module[
{ytails},
ytails = Complement[
Union[Cases[μ, t[s_] :> s, Infinity]],
xtails
];
hfac[z,xtails -> x, ytails -> y][μ]
];
hfac[z_, x_,  ytails_List -> y_][μ_] := Module[
{xtails},
xtails = Complement[
Union[Cases[μ, t[s_] :> s, Infinity]],
ytails
];
hfac[z,xtails -> x, ytails -> y][μ]
];
hfac[z_, xtails_List -> x_, ytails_List -> y_][μ_] := Module[
{ζ, ξ, η},
ζ = D[μ, h[z]];
ξ = ζ /. ((t[#]->0)& /@ ytails);
η = ζ /. ((t[#]->0)& /@ xtails);
μCollect[μ-h[z]ζ + h[x]ξ + h[y]η/(1+ξ /. t[s_]->c[s])]
]

hm[3,4,5][ar[1,3]+ar[2,4]] // μForm

hm[3,4,5][ar[1,3]+ar[2,4]] // hfac[5,{1}->3, 4]

conj2 is designed to work only in the feedback case.

t[y] -> (a1+a2 c[y])t[y]/(1+γ(a3+a4 c[y]))

conj2[y_,x_][μ_] := Module[
{γ},
γ = Coefficient[μ, ar[y,x]];
μCollect[μ /. t[y] -> (a1+a2 c[y])γ t[y]/(1+γ(a3+a4 c[y]))]
];

Riffle[
ComposeList[
ops={conj2[1,2], conj2[1,3], hm[2,3,2]},
μ3 =0(Subscript[α, 1]) ar[1,1] + (Subscript[α, 2]) ar[2,1] + (Subscript[α, 3]) ar[1,2] + (Subscript[α, 4]) ar[1,3]
]// μForm,
ops
]

Riffle[
ComposeList[
ops={hm[2,3,2], conj2[1,2]},
μ3 
]// μForm,
ops
]

{c2l = μ3 // conj2[1,2] // conj2[1,3] // hm[2,3,2], c2r = μ3 //  hm[2,3,2] // conj2[1,2]}

SolveAlways[c2l==c2r, {t[1], t[2], h[1], h[2], (Subscript[α, 1]), (Subscript[α, 2]), (Subscript[α, 3]), (Subscript[α, 4]), c[1]}]

μForm/@ ({c2l, c2r} /. {a1->1, a2->0})

SolveAlways[c2l==c2r /. {a1->1, a2->0}, {t[1], t[2], h[1], h[2], (Subscript[α, 1]), (Subscript[α, 2]), (Subscript[α, 3]), (Subscript[α, 4]), c[1]}]